home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / copymove.swg / 0008_Copy File from ECO-LIB.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-05-28  |  1.7 KB  |  86 lines
  1. {
  2. Note : Functions beginning with "__" come from the ECO Library - Kerry.
  3.  
  4. FLOOR A.C. NAAIJKENS
  5.  
  6. The Norton-like bar along with the copying won't compile
  7.  
  8. {$I-}
  9. function __copyfil(show : boolean; x1, x2, y, f, b : byte;
  10.                    fs : longint; src, targ : string) : byte;
  11. {
  12.  return codes:
  13.   0 successful
  14.   1 source and target the same
  15.   2 cannot open source
  16.   3 unable to create target
  17.   4 error during copy
  18.   5 cannot allocate buffer
  19. }
  20. const
  21.   bufsize = 16384;
  22.  
  23. type
  24.   fbuf = array[1..bufsize] of char;
  25.   fbf  = ^fbuf;
  26.  
  27. var
  28.   source,
  29.   target   :    file;
  30.   bread,
  31.   bwrite   :    word;
  32.   filebuf  :    ^fbf;
  33.   tr       : longint;
  34.   nr       :    real;
  35.  
  36. begin
  37.   if memavail > bufsize then
  38.     new(filebuf)
  39.   else
  40.   begin
  41.     __copyfil := 5;
  42.     exit
  43.   end;
  44.   if src = targ then
  45.   begin
  46.     __copyfil := 1;
  47.     exit
  48.   end;
  49.   assign(source, src);
  50.   reset(source,1);
  51.   if ioresult <> 0 then
  52.   begin
  53.     __copyfil := 2;
  54.     exit
  55.   end;
  56.   assign(target, targ);
  57.   rewrite(target,1);
  58.   if ioresult <> 0 then
  59.   begin
  60.     __copyfil := 3;
  61.     exit
  62.   end;
  63.   if show then
  64.     __write(x1 + 2 , y, f, b, __rep(x2 - x1 - 3, '░'));
  65.   tr := 0;
  66.   repeat
  67.     blockread(source, filebuf^, bufsize, bread);
  68.     tr := tr + bread;
  69.     nr := tr / fs;
  70.     nr := nr * (x2 - x1 - 3);
  71.     if show then
  72.       __write(x1 + 2, y, f, b, __rep(trunc(nr), '█'));
  73.     blockwrite(target, filebuf^, bread, bwrite);
  74.   until (bread = 0) or (bread <> bwrite);
  75.   if show then
  76.     __write(x1 + 2, y, f, b, __rep((x2 - x1 - 3), '█'));
  77.   close(source);
  78.   close(target);
  79.   if bread <> bwrite then
  80.     __copyfil := 4
  81.   else
  82.     __copyfil := 0;
  83. end;
  84. {$I-}
  85.  
  86.